home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Technotools
/
Technotools (Chestnut CD-ROM)(1993).ISO
/
lang_oth
/
tasking
/
getpsp.mod
< prev
next >
Wrap
Text File
|
1986-04-05
|
3KB
|
97 lines
IMPLEMENTATION MODULE GetPSP;
FROM SYSTEM IMPORT
BYTE, ADDRESS, SWI, RTSVECTOR, SETREG, GETREG, AX, BX, CX;
PROCEDURE getarg(argnum: argno; VAR arg: ARRAY OF CHAR);
(*
returns empty string for arg(numberOfArgs+1)
returns a program name for arg(0) (may be phoney)
args are delimited by blanks
*)
VAR
i, j, len, cmd: CARDINAL;
BEGIN
WITH PSPptr^ DO
len := ORD(commTail[0]);
i := 1;
(* skip leading blank(s) *)
WHILE (i <= len) & (commTail[i] = ' ') DO INC(i) END;
(* skip to requested arg *)
j := 0;
WHILE (i <= len) & (j < argnum) DO
WHILE (i <= len) & (commTail[i] # ' ') DO INC(i) END;
WHILE (i <= len) & (commTail[i] = ' ') DO INC(i) END;
INC(j);
END;
(* copy requested arg *)
j := 0;
WHILE (i <= len) & (commTail[i] # ' ') & (j <= HIGH(arg)) DO
arg[j] := commTail[i];
INC(j);
INC(i);
END;
END; (* with *)
IF j <= HIGH(arg) THEN arg[j] := 0C END;
END getarg;
PROCEDURE getenv(key: ARRAY OF CHAR; VAR val: ARRAY OF CHAR);
VAR
i, j, cnt: CARDINAL;
found: BOOLEAN;
match: BOOLEAN;
PROCEDURE toupper(ch: CHAR): CHAR;
BEGIN
IF (ch >= 'a') & (ch <= 'z') THEN
ch := CAP(ch);
END;
RETURN ch;
END toupper;
BEGIN (* getenv *)
i := 0;
cnt := 0;
WHILE ENVIRptr^[cnt] # 0C DO (* while not last string *)
j := 0;
match := TRUE;
REPEAT
IF match THEN (* still matching ?*)
IF ((j > HIGH(key)) OR (key[j] = 0C)) THEN (* end of key string ? *)
IF ENVIRptr^[cnt] = '=' THEN (* end of env name ? *)
j := 0; (* copy env to result string *)
REPEAT
INC(cnt);
val[j] := ENVIRptr^[cnt];
INC(j);
UNTIL ENVIRptr^[cnt] = 0C;
RETURN; (* found *)
ELSE
match := FALSE;
END;
ELSE (* still comparing *)
match := toupper(key[j]) = ENVIRptr^[cnt];
END;
INC(j);
END; (* if match *)
INC(cnt);
UNTIL ENVIRptr^[cnt] = 0C; (* end of one env string *)
INC(cnt);
END; (* while *)
val[0] := 0C; (* no match *)
END getenv;
VAR
tmpPtr: ADDRESS;
BEGIN
SETREG(AX, 0026H); (* RTS(38) - get Program Segment Prefix Pointer *)
SWI(RTSVECTOR); (* rts call *)
GETREG(BX, tmpPtr.OFFSET);
GETREG(CX, tmpPtr.SEGMENT);
PSPptr := tmpPtr;
tmpPtr.SEGMENT := PSPptr^.EnvironmentSeg;
tmpPtr.OFFSET := 0;
ENVIRptr := tmpPtr;
END GetPSP.